Sub 电解对标()
'--------------------------------------------
'Finished at 2011-09-12
'Mended at 2011-12-19
'指标名称去掉"(股份)",指标名称后面添加指标单位
'--------------------------------------------
Dim DJend As Integer
Dim H As Range   '判断200KA、400KA的所属单位
Dim I As Range      '当前单元格
Dim ZhD, ZhL As Integer   '指标表中当月和累计的列号
Static j As Integer    '行号
Static k As Integer    '列号
Static L As Integer    '指标编号
Static N As Integer    '系列编号
ZhD = 5
ZhL = 6
If ActiveSheet.Range("A1").Text <> "**" Then    '识别表
    MsgBox "请选择指标表,标志符（在表A1单元格中）为：**"
    Exit Sub
End If
m = 1
While Cells(m, 1).Value <> "#"
    m = m + 1
Wend
DJend = m   '电解结束行号，以#为分隔标记
L = 1       '电解指标计数
For m = 5 To DJend Step 1       '从第5行开始,前面有标题包含"铝业"字符
    Set I = Cells(m, 1)
    N = PDXL(I)
    Select Case N
        Case 0
            I.Offset(0, 11).Value = Left(Trim(I.Text), Len(Trim(I.Text)) - 4) & "(" & I.Offset(0, 1).Text & ")"  '去掉"(股份)"添加单位以修正指标名称
            k = 4 * L - 1
            CopytoSpecificSheet I.Offset(0, 11), 2, k + 4, 1  '综合，第一列指标为产量
            CopytoSpecificSheet I.Offset(0, 11), 2, k, 2
            CopytoSpecificSheet I.Offset(0, 11), 2, k, 3
            L = L + 1
            With I.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.799981688894314
                .PatternTintAndShade = 0
            End With
        Case 1
            Set H = I
            j = PDHH(1, I)
            CopytoSpecificSheet I.Offset(0, ZhD - 1), j, k + 1 + 4, 1 '综合，第一列产量为产量
            CopytoSpecificSheet I.Offset(0, ZhL - 1), j, k + 3 + 4, 1 '综合，第一列产量为产量
            With I.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent5
                .TintAndShade = 0.799981688894314
                .PatternTintAndShade = 0
            End With
        Case 2
            j = PDHH(2, H)
            CopytoSpecificSheet I.Offset(0, ZhD - 1), j, k + 1, 2
            CopytoSpecificSheet I.Offset(0, ZhL - 1), j, k + 3, 2
            With I.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent4
                .TintAndShade = 0.799981688894314
                .PatternTintAndShade = 0
            End With
        Case 3
            j = PDHH(3, H)
            CopytoSpecificSheet I.Offset(0, ZhD - 1), j, k + 1, 3
            CopytoSpecificSheet I.Offset(0, ZhL - 1), j, k + 3, 3
            With I.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = 0.799981688894314
                .PatternTintAndShade = 0
            End With
        Case Else    '不属于任何系列
            With I.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 5296274
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
    End Select
Next
L = 1               '碳素指标初始计数
While Cells(DJend, 1).Value <> "##"     '炭素对标
    Set I = Cells(DJend, 1)
    With I
    If I.Text Like "*股份*" _
        And (I.Text Like "*[(（]#[)）]*" _
            Or I.Text Like "*[(（]##[)）]*" _
            Or I.Text Like "*[(（]##-#[)）]*") Then
        L = L + 1       '刚好跳过了第一个指标为产量,顺便也起到计数的作用
        I.Offset(0, 11).Value = Left(Trim(I.Text), Len(Trim(I.Text)) - 4) & "(" & I.Offset(0, 1).Text & ")"  '去掉"(股份)"添加单位以修正指标名称
        Sheet5.Cells(2, 4 * L - 1).Value = I.Offset(0, 11).Text   '填入碳素指标名称
    ElseIf .Text Like "*山东分公司*" Then       '填入碳素指标
            Sheet5.Cells(4, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(4, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        ElseIf .Text Like "*河南分公司*" Then
            Sheet5.Cells(5, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(5, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        ElseIf .Text Like "*贵州分公司*" Then
            Sheet5.Cells(6, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(6, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        ElseIf .Text Like "*广西分公司*" Then
            Sheet5.Cells(7, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(7, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        ElseIf .Text Like "*青海分公司*" Then
            Sheet5.Cells(8, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(8, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        ElseIf .Text Like "*山西华泽铝*" Then
            Sheet5.Cells(9, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(9, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        ElseIf .Text Like "*兰州分公司*" Then
            Sheet5.Cells(10, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(10, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        ElseIf .Text Like "*华圣铝业*" Then
            Sheet5.Cells(11, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(11, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        ElseIf .Text Like "*抚顺铝业*" Then
            Sheet5.Cells(12, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(12, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        ElseIf .Text Like "*焦作万方铝*" Then
            Sheet5.Cells(13, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(13, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        ElseIf .Text Like "*山东华宇铝*" Then
            Sheet5.Cells(14, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(14, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        ElseIf .Text Like "*华鹭铝业*" Then
            Sheet5.Cells(15, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(15, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        ElseIf .Text Like "*包头铝业*" Then
            Sheet5.Cells(16, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(16, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        ElseIf .Text Like "*连城分公司*" Then
            Sheet5.Cells(17, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(17, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        ElseIf .Text Like "*青海黄河*" Then
            Sheet5.Cells(18, 4 * L).Value = I.Offset(0, ZhD - 1).Text
            Sheet5.Cells(18, 4 * L + 2).Value = I.Offset(0, ZhL - 1).Text
        Else: I.Font.Strikethrough = True '不使用的单元格添加删除线。
                                        'I.Interior.Color = RGB(200, 0, 0)设置背景色的方法
    End If
    End With
    DJend = DJend + 1
Wend
L = 1   '电厂指标初始计数
While Cells(DJend, 1) <> "###"  '电厂对标
    With Cells(DJend, 1)
    If .Text Like "*[(（]#[)）]*" _
            Or .Text Like "*[(（]##[)）]*" _
            Or .Text Like "*[(（]##-#[)）]*" Then
        L = L + 1       '刚好跳过了第一个指标为产量,顺便也起到计数的作用
        .Offset(0, 11).Value = Trim(.Text) & "(" & .Offset(0, 1).Text & ")"  '对指标名称添加单位
        Sheet6.Cells(2, 4 * L - 1).Value = .Offset(0, 11).Text   '填入电厂指标名称
    ElseIf .Text Like "*山东分公司*" Then       '填入电厂指标
            Sheet6.Cells(4, 4 * L).Value = .Offset(0, ZhD - .Column).Text   '(ZhD - .Column)计划当月列相对名称列的偏移数
            Sheet6.Cells(4, 4 * L + 2).Value = .Offset(0, ZhL - .Column).Text
        ElseIf .Text Like "*河南分公司*" Then
            Sheet6.Cells(5, 4 * L).Value = .Offset(0, ZhD - .Column).Text
            Sheet6.Cells(5, 4 * L + 2).Value = .Offset(0, ZhL - .Column).Text
        ElseIf .Text Like "*贵州分公司*" Then
            Sheet6.Cells(6, 4 * L).Value = .Offset(0, ZhD - .Column).Text
            Sheet6.Cells(6, 4 * L + 2).Value = .Offset(0, ZhL - .Column).Text
        ElseIf .Text Like "*山西分公司*" Then
            Sheet6.Cells(7, 4 * L).Value = .Offset(0, ZhD - .Column).Text
            Sheet6.Cells(7, 4 * L + 2).Value = .Offset(0, ZhL - .Column).Text
        ElseIf .Text Like "*广西分公司*" Then
            Sheet6.Cells(8, 4 * L).Value = .Offset(0, ZhD - .Column).Text
            Sheet6.Cells(8, 4 * L + 2).Value = .Offset(0, ZhL - .Column).Text
        ElseIf .Text Like "*中州分公司*" Then
            Sheet6.Cells(9, 4 * L).Value = .Offset(0, ZhD - .Column).Text
            Sheet6.Cells(9, 4 * L + 2).Value = .Offset(0, ZhL - .Column).Text
        ElseIf .Text Like "*山西华泽铝*" Then
            Sheet6.Cells(10, 4 * L).Value = .Offset(0, ZhD - .Column).Text
            Sheet6.Cells(10, 4 * L + 2).Value = .Offset(0, ZhL - .Column).Text
        ElseIf .Text Like "*兰州分公司*" Then
            Sheet6.Cells(11, 4 * L).Value = .Offset(0, ZhD - .Column).Text
            Sheet6.Cells(11, 4 * L + 2).Value = .Offset(0, ZhL - .Column).Text
        ElseIf .Text Like "*焦作万方*" Then
            Sheet6.Cells(12, 4 * L).Value = .Offset(0, ZhD - .Column).Text
            Sheet6.Cells(12, 4 * L + 2).Value = .Offset(0, ZhL - .Column).Text
        ElseIf .Text Like "*山东华宇*" Then
            Sheet6.Cells(13, 4 * L).Value = .Offset(0, ZhD - .Column).Text
            Sheet6.Cells(13, 4 * L + 2).Value = .Offset(0, ZhL - .Column).Text
        ElseIf .Text Like "*重庆分公司*" Then
            Sheet6.Cells(14, 4 * L).Value = .Offset(0, ZhD - .Column).Text
            Sheet6.Cells(14, 4 * L + 2).Value = .Offset(0, ZhL - .Column).Text
        ElseIf .Text Like "*遵义*" Then
            Sheet6.Cells(15, 4 * L).Value = .Offset(0, ZhD - .Column).Text
            Sheet6.Cells(15, 4 * L + 2).Value = .Offset(0, ZhL - .Column).Text
        Else: .Font.Strikethrough = True '不使用的单元格添加删除线
    End If
    End With
    DJend = DJend + 1
Wend
End Sub

Function PDXL(Ncells As Range) As Integer
'根据单元格内容判断属于指标名称的行，还是各单位综合的、各系列的行（输入单元格类型，返回整型）
If Ncells.Text Like "*股份*" _
    And (Ncells.Text Like "*[(（]#[)）]*" _
      Or Ncells.Text Like "*[(（]##[)）]*" _
      Or Ncells.Text Like "*[(（]##-#[)）]*") Then
    PDXL = 0    '指标名称
ElseIf Ncells.Text _
    Like "*公司*" Or Ncells.Text _
    Like "*铝业*" Or Ncells.Text _
    Like "*铝电*" Or Ncells.Text _
    Like "*水电*" Then
        PDXL = 1 '综合指标
ElseIf Ncells.Text Like "*200*" Then
        PDXL = 2  '200KA槽型
ElseIf Ncells.Text _
    Like "*280*" Or Ncells.Text _
    Like "*300*" Or Ncells.Text _
    Like "*330*" Or Ncells.Text _
    Like "*350*" Or Ncells.Text _
    Like "*400*" Or Ncells.Text _
    Like "*500*" Then
        PDXL = 3 '400KA及近似槽型
Else
        PDXL = 4
'    MsgBox ("无法判断出属于哪个系列")
End If
End Function

Function PDHH(xlh As Integer, Ncells As Range) As Integer
Select Case xlh
    Case 1
        With Ncells
            If .Text Like "*山东分公司*" Then
                PDHH = 4
                ElseIf .Text Like "*贵州分公司*" Then
                PDHH = 5
                ElseIf .Text Like "*广西分公司*" Then
                PDHH = 6
                ElseIf .Text Like "*青海分公司*" Then
                PDHH = 7
                ElseIf .Text Like "*郑州研究院*" Then
                PDHH = 8
                ElseIf .Text Like "*山西华泽铝*" Then
                PDHH = 9
                ElseIf .Text Like "*兰州分公司*" Then
                PDHH = 10
                ElseIf .Text Like "*华圣铝业*" Then
                PDHH = 11
                ElseIf .Text Like "*抚顺铝业*" Then
                PDHH = 12
                ElseIf .Text Like "*焦作万方铝*" Then
                PDHH = 13
                ElseIf .Text Like "*遵义铝业*" Then
                PDHH = 14
                ElseIf .Text Like "*山东华宇铝*" Then
                PDHH = 15
                ElseIf .Text Like "*华鹭铝业*" Then
                PDHH = 16
                ElseIf .Text Like "*山西龙门铝*" Then
                PDHH = 17
                ElseIf .Text Like "*包头铝业*" Then
                PDHH = 18
                ElseIf .Text Like "*连城分公司*" Then
                PDHH = 19
                ElseIf .Text Like "*青海黄河水*" Then
                PDHH = 20
                Else: .Interior.Color = RGB(200, 0, 0) 'MsgBox ("综合指标里无此公司")
            End If
        End With
    Case 2
        With Ncells
            If .Text Like "*山东分公司*" Then
                PDHH = 4
                ElseIf .Text Like "*青海分公司*" Then
                PDHH = 5
                ElseIf .Text Like "*兰州分公司*" Then
                PDHH = 6
                ElseIf .Text Like "*抚顺铝业*" Then
                PDHH = 7
                ElseIf .Text Like "*遵义铝业*" Then
                PDHH = 8
                ElseIf .Text Like "*包头铝业*" Then
                PDHH = 9
                ElseIf .Text Like "*连城分公司*" Then
                PDHH = 10
                Else: .Interior.Color = RGB(200, 0, 0) 'MsgBox ("200KA指标里无此公司")
            End If
        End With
    Case 3
        With Ncells
            If .Text Like "*郑州研究院*" Then
                PDHH = 4
                ElseIf .Text Like "*山西华泽铝*" Then
                PDHH = 5
                ElseIf .Text Like "*兰州分公司*" Then
                PDHH = 6
                ElseIf .Text Like "*华圣铝业*" Then
                PDHH = 7
                ElseIf .Text Like "*抚顺铝业*" Then
                PDHH = 8
                ElseIf .Text Like "*焦作万方铝*" Then
                PDHH = 9
                ElseIf .Text Like "*遵义铝业*" Then
                PDHH = 10
                ElseIf .Text Like "*包头铝业*" Then
                PDHH = 11
                ElseIf .Text Like "*连城分公司*" Then
                PDHH = 12
                ElseIf .Text Like "*青海黄河水*" Then
                PDHH = 13
                Else: .Interior.Color = RGB(200, 0, 0) 'MsgBox ("400KA指标里无此公司")
            End If
        End With
    Case Else
        MsgBox ("无此系列")
End Select
End Function

Public Function CopytoSpecificSheet(beCopyed As Range, o As Integer, p As Integer, q As Integer)
'将一个单元格的内容复制到指定表的指定位置
'beCopyed：被复制单元格，o：目标行号，p：目标列号，q：目标表号（1，2，3为有效值，参看PDXL函数)
'CopytoSpecificSheet = False
Select Case q
    Case 1
        Sheet7.Cells(o, p).Value = beCopyed.Text '综合指标
'        CopytoSpecificSheet = True
    Case 2
        Sheet8.Cells(o, p).Value = beCopyed.Text '200KA槽型
'        CopytoSpecificSheet = True
    Case 3
        Sheet9.Cells(o, p).Value = beCopyed.Text '400KA及近似槽型
'        CopytoSpecificSheet = True
    Case Else
        MsgBox (没有此工作表)
End Select
End Function
